home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Hasht.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  4.5 KB  |  163 lines  |  [TEXT/R*ch]
  1. (* Hasht.sml *)
  2.  
  3. (* Hash tables *)
  4.  
  5. (* We do dynamic hashing, and we double the size of the table when
  6.    buckets become too long, but without re-hashing the elements. *)
  7.  
  8. open Array;
  9. infix 9 sub;
  10.  
  11. datatype ('a, 'b) bucketlist =
  12.     Empty
  13.   | Cons of 'a * int * 'b * ('a, 'b) bucketlist
  14. ;
  15.  
  16. type ('a, 'b) TCell =
  17.   { max_len: int,                      (* max length of a bucket *)
  18.     data: ('a, 'b) bucketlist array }  (* the buckets *)
  19. ;
  20.  
  21. type ('a, 'b) t = ('a, 'b) TCell ref;
  22.  
  23. fun forup f a b =
  24.   let fun loop i = if i > b then () else (f i; loop (i+1))
  25.   in loop a end
  26. ;
  27.  
  28. fun new initial_size =
  29.   ref { max_len = 3, data = array(initial_size, Empty) }
  30. ;
  31.  
  32. fun clear h =
  33.   let val {data, max_len} = !h in
  34.     forup (fn i => update(data, i, Empty))
  35.       0 (Array.length data - 1)
  36.   end
  37. ;
  38.  
  39. fun resize h =
  40.   let val {data, max_len} = !h
  41.       val len = Array.length data
  42.       val newlen = len+len+1
  43.       val newdata = array(newlen, Empty)
  44.       fun dispatch Empty = ()
  45.         | dispatch (Cons(k, c, v, rest)) =
  46.             let val () = dispatch rest
  47.                 val i = c mod newlen
  48.             in update(newdata, i, Cons(k, c, v, newdata sub i)) end
  49.   in
  50.     forup (fn i => dispatch(data sub i)) 0 (len-1);
  51.     h := { data = newdata, max_len = 2 * max_len};
  52.     ()
  53.   end
  54. ;
  55.  
  56. fun bucket_too_long n bucket =
  57.   if n < 0 then true else
  58.   case bucket of
  59.       Empty => false
  60.     | Cons(_, _, _, rest) => bucket_too_long (n-1) rest
  61. ;
  62.  
  63. prim_val hash_param : int -> int -> 'a -> int = 3 "hash_univ_param";
  64.  
  65. fun hash x = hash_param 50 500 x;
  66.  
  67. fun insert h key value =
  68.   let val {data, max_len} = !h
  69.       val code = hash_param 10 100 key
  70.       fun insert_bucket Empty =
  71.             Cons(key, code, value, Empty)
  72.         | insert_bucket (Cons(k, c, v, next)) =
  73.             if code = c andalso k = key then
  74.               Cons(key, code, value, next)
  75.             else Cons(k, c, v, insert_bucket next)
  76.       val i = code mod (Array.length data)
  77.       val bucket = insert_bucket (data sub i)
  78.   in
  79.     update(data, i, bucket);
  80.     if bucket_too_long max_len bucket then resize h else ()
  81.   end
  82. ;
  83.  
  84. fun remove h key =
  85.   let val {data, max_len : int} = !h
  86.       val code = hash_param 10 100 key
  87.       fun remove_bucket Empty = Empty
  88.         | remove_bucket (Cons(k, c, v, next)) =
  89.             if code = c andalso k = key then
  90.               next
  91.             else Cons(k, c, v, remove_bucket next)
  92.       val i = code mod (Array.length data)
  93.   in update(data, i, remove_bucket (data sub i)) end
  94. ;
  95.  
  96. fun find h key =
  97.   let val {data, max_len : int} = !h
  98.       val code = (hash_param 10 100 key)
  99.   in
  100.   case data sub (code mod (Array.length data)) of
  101.       Empty => raise Subscript
  102.     | Cons(k1, c1, d1, rest1) =>
  103.         if code = c1 andalso key = k1 then d1 else
  104.         case rest1 of
  105.           Empty => raise Subscript
  106.         | Cons(k2, c2, d2, rest2) =>
  107.             if code = c2 andalso key = k2 then d2 else
  108.             case rest2 of
  109.                 Empty => raise Subscript
  110.               | Cons(k3, c3, d3, rest3) =>
  111.                 if code = c3 andalso key = k3 then d3 else
  112.                 let fun find Empty = raise Subscript
  113.                       | find (Cons(k, c, d, rest)) =
  114.                           if code = c andalso key = k then d else find rest
  115.                 in find rest3 end
  116.   end;
  117.  
  118. fun peek h key =
  119.   let val {data, max_len : int} = !h
  120.       val code = (hash_param 10 100 key)
  121.   in
  122.   case data sub (code mod (Array.length data)) of
  123.       Empty => raise Subscript
  124.     | Cons(k1, c1, d1, rest1) =>
  125.         if code = c1 andalso key = k1 then SOME d1 else
  126.         case rest1 of
  127.           Empty => NONE
  128.         | Cons(k2, c2, d2, rest2) =>
  129.             if code = c2 andalso key = k2 then SOME d2 else
  130.             case rest2 of
  131.                 Empty => NONE
  132.               | Cons(k3, c3, d3, rest3) =>
  133.                 if code = c3 andalso key = k3 then SOME d3 else
  134.                 let fun peek Empty = NONE
  135.                       | peek (Cons(k, c, d, rest)) =
  136.                           if code = c andalso key = k then SOME d 
  137.               else peek rest
  138.                 in peek rest3 end
  139.   end;
  140.  
  141. fun apply f h =
  142.   let val {data, max_len : int} = !h
  143.       val len = Array.length data
  144.   in
  145.     forup (fn i =>
  146.         let fun scan_bucket Empty = ()
  147.               | scan_bucket (Cons(k, c, d, rest)) =
  148.                   ( f k d : unit; scan_bucket rest )
  149.         in scan_bucket (data sub i) end)
  150.       0 (len - 1)
  151.   end
  152. ;
  153.  
  154. fun fold f e h =
  155.   let val {data, max_len : int} = !h
  156.       fun fold_bucket (Empty, res) = res
  157.     | fold_bucket (Cons(k, c, d, rest), res) = 
  158.       fold_bucket (rest, f k d res)
  159.   in
  160.       Array.foldl fold_bucket e data 
  161.   end
  162. ;
  163.